  ' MMBasic Program Source Crunch v2.4
  ' Hugh Buckle  April 2013
  '***********************************************************************
  ' This program reduces the size of a source program by
  ' - removing all blank lines
  ' - removing all comments
  ' - removing all indentation
  ' - optionally replacing all variable and label names with short ones
  ' - optionally replacing all function and subroutine names with short ones.

  ' Note that this program does not support code with line numbers.

  ' Planned enhancements:
  ' - removing all unnecessary blanks in statements
  ' - compressing text by creating multiple-statement lines
  '***********************************************************************

  True=1
  False=Not True
  Testing=False
  GenVarTrace=False
  VarStartMark$="~"
  VarEndMark$="~"

  '***********************************************************************
  'Files used by Crunch. 1, 3 and 4 are input. The rest are output.
  '5, 6, 7, and 8 are temporary files, which are removed when Crunch finishes.
  '***********************************************************************
  'Ifile$                        1 Is supplied by the user - see Sub GetParms
  'Ofile$                        2 Is also provided by the user in GetParms
  InDatFile$    = "Crunch.dat" '3 Parameter file of i/o filenames and switches
  RwordFile$    = "Rword.CSV"   '4 Reserved word list in CSV format
  VariableFile$ = "CrunchV.tmp"'5 Unsorted variables
  TempFile$     = "CrunchC.tmp" '6 Marked source code passed to Crunch Part II
  LabelFile$    = "CrunchL.tmp" '7 Unsorted list of labels and function names
  OutDatFile$   = "Cruncha.dat" '8 Parameters passed to Crunch Part II

  CrunchPart2$   = "Cruncha.bas" 'Crunch Part II program name

  'InFileName[.bas] OutFileName[.bas] [switch... switch]
  ' This sorted Reserved Words file is created using RWRDSORT.BAS
  ' It is formatted as a series of CSV records.

  ' Populate an array of separators - used in finding labels.
  Data " ",",","(",")",":",";","=","+","-","*","/","<",">","\","^","#","%"
  Separators=17
  Dim Separator$(Separators)
  For I=1 To Separators
    Read Separator$(i)
  Next

  '***********************************************************************
  ' Mainline
  '***********************************************************************

  Cls
  DefaultLineLen=80
  GetParms(Ifile$, Ofile$, Indent)
  LoadReservedWords(RWordFile$)

  '**********************************************************
  'There is an option to change Subroutine and Function names and labels.
  'Command line switch /L suppresses this function.
  'If they are to be changed then a list is needed so that they can be treated
  'like reserved words when looking for variable names.
  'Labels are temporarily accumulated in LabelFile$ then loaded into the Label$
  'array in ASCII sequence, eliminating duplicates.
  '**********************************************************
  If NoLblChange Or NoFuncNameChange=True Then
    BuildLabelArray
    If Not testing Then Kill LabelFile$
  EndIf

  '**********************************************************
  'Now we need to identify variables and mark them in the source for later
  'replacement with short names. As they are found, variables are written
  'to VariableFile$. Some duplicates can be eliminated before being written
  'by comparing with a last-used-first-out stack. The marked source is
  'written to TempFile$.
  '**********************************************************
  Print "Opening variable file ";VariableFile$;" for output"
  Open VariableFile$ For output As #5
  Open TempFile$ For output As #6
  StackLimit=40
  Dim Stack$(StackLimit) 'Stack of recently found variables
  Print "Identifying labels, variables, Functions and Subs in the source."
  Do
    ProcessALine
    If Cline$<>"" Then
      Print #6,Cline$               ' Write line to temporary file
      If Pauselist Or testing Then PrintMsg("Output "+Cline$)
    EndIf
  Loop Until Eof(#1)

  Close #1,#5,#6                                ' Close input file

  '**********************************************************
  'Due to memory limitations, control is passed to CrunchA.bas
  'to continue with the crunch process.
  '**********************************************************

  WriteCrunchPart2ParmFile
  Print "Transferring control to Crunch Part II"
  Run CrunchPart2$
End

Sub BuildVariableArray(Count)
  '**********************************************************
  'Copies the temporary array to one of the correct size and
  'adds a replacement name for each variable.
  '**********************************************************
  Dim Variable$(MaxVariables)
     For i=1 To MaxVariables
      Variable$(i)=UCase$(Entry$(i))+","+NewVarName$(Entry$(i))
    Next
    Erase Entry$
End Sub 'BuildVariableArray

Function NewVarName$(OldName$)
  '**********************************************************
  'Assigns a new uppercase short name. Alpha and numeric variables
  'share the same sequence of one and two character names.
  '**********************************************************
  If Right$(OldName$,1)="$" Then
  'This routine is just for text names
    If AlphaNo2=0 Then
      AlphaNo2=65
    Else
      AlphaNo2=AlphaNo2+1
      If AlphaNo2>90 Then
        If AlphaNo1=0 Then
          AlphaNo1=65
        Else
          AlphaNo1=AlphaNo1+1
        EndIf
        AlphaNo2=65
      EndIf
    EndIf
    If AlphaNo1=0 Then
      NewVarName$=Chr$(AlphaNo2)+"$"
    Else
      NewVarName$=Chr$(Alphano1)+Chr$(AlphaNo2)+"$"
    EndIf
  'Next routine is just for numeric names
  Else
    If NumNo2=0 Then
      NumNo2=65
    Else
      NumNo2=NumNo2+1
      If NumNo2>90 Then
        If NumNo1=0 Then
          NumNo1=65
        Else
          NumNo1=NumNo1+1
        EndIf
        NumNo2=65
      EndIf
    EndIf
    If NumNo1=0 Then
      NewVarName$=Chr$(NumNo2)
    Else
      NewVarName$=Chr$(NumNo1)+Chr$(NumNo2)
    EndIf
  EndIf
End Function 'NewVarName

Sub ProcessALine
  '**********************************************************
  'Looks at each input source line in turn and invokes processing
  'based upon the options selected.
  '**********************************************************
  IgnoreLine=false
  Line Input #1,Cline$
  Cline$=StripBlanks$(Cline$)   ' remove all leading blanks
  If NoRemoveComments=False Then Cline$=RemoveCommentsAndBlankLines$(Cline$)
  If NoVarNameChange=False Then FindVariables(Cline$)
End Sub 'ProcessALine

Sub FindVariables(Cline$)
  '**********************************************************
  'Identifies and marks variables and optionally labels, sub and
  'function names.
  '**********************************************************
  Local i,j,v$
  i=1                'First char to look at
  Do
    a$=UCase$(Cline$)
    b$=Mid$(a$,i,1)    'Get the next character

    If b$=Chr$(34) Then
      Do                         ' skip over quoted text
        i=i+1
        b$=Mid$(a$,i,1)
      Loop Until b$=Chr$(34) Or i=Len(a$)
    EndIf
    ' A variable must start with an alpha or underscore
    If (b$>="A" And b$<="Z") Or b$="_" Then
      j=i

      'Get the remaining charaters of this word
      'Characters allowed in a variable are a-x, 0-9, . and _
      Do
        j=j+1
        b$=Mid$(a$,j,1)
      Loop Until (b$<"A" Or b$>"Z") And (b$<"0" Or b$>"9") And b$<>"_" And b$<>"."
      'If the next character is $ then include that in the word
      If Mid$(a$,j,2)="$(" Then
        j=j+2
      ElseIf b$="$" Or b$="(" Then
        j=j+1
      EndIf

      'A variable or reserved word has been found
      v$=Mid$(a$,i,j-i)
      If IsACommand(v$) Or ((NoLblChange Or NoFuncNameChange) And IsALabel(v$)) Then
        i=j
      Else
        If Right$(v$,1)="(" Then
          'If not a command and ends in a (, then it is an array variable
          v$=Left$(v$,Len(v$)-1)
          SaveVariable(v$)
          MarkVariable(Cline$,i,j-1)
          a$=UCase$(Cline$)
          i=j     'Move start pointer to the closing variable mark
        Else
          'What's left are non-array text and numeric variables
          SaveVariable(v$)
          MarkVariable(Cline$,i,j)
          a$=UCase$(Cline$)
          i=j+1     'Move start pointer to the closing variable mark
        EndIf
      EndIf
    Else
      i=i+1   'Increment start pinter to next character
    EndIf
  Loop Until i>Len(a$)
End Sub 'FindVariables

Sub SaveVariable(V$)
  '**********************************************************
  'This routine keeps recently found variables in a Least-Used-
  'First-Out stack. A variable is added to the top of the stack
  'and written to the file if it isn't already on the Stack.
  'Since variables tend to be used in groups, this should reduce
  'the number of duplicates written to the file. The count of
  'variables written will be used in the next phase to allocate
  'an array for sorting and eliminating remaining duplicates.
  '**********************************************************
  Local Found,x$,i
  Found=False
  If StackEntries>0 Then
    'See if it is already in the stack
    For StackPtr=1 To StackEntries
      If v$=Stack$(StackPtr) Then
        Found=True
        Exit For
      EndIf
    Next
  EndIf

  If Found=true Then
    'Promote this variable if not at the top of the stack
    If StackPtr<>1 Then
      x$=Stack$(StackPtr-1)
      Stack$(StackPtr-1)=Stack$(StackPtr)
      Stack$(StackPtr)=x$
    EndIf
  EndIf

  If found=false Then
    'Increase stack size up to the set limit.
    If StackEntries<StackLimit Then StackEntries=StackEntries+1

    'Demote all existing entries, loosing the last then
    'add the new entry at the top of the stack and
    'Write the variable to the file.
    If stackEntries>1 Then
      For i=StackEntries-1 To 1 Step-1
        Stack$(i+1)=Stack$(i)
      Next
    EndIf
    Stack$(1)=v$
    Print #5,v$
    MaxVariables=MaxVariables+1
  EndIf
End Sub 'SaveVariable

Sub MarkVariable(a$,i,j)
  '**********************************************************
  ' Each variable is enclosed in curley brackets in the
  ' temporary output file to make replacing each with a short
  ' name is quicker and easier.
  ' On entry a$ is the current line of code
  '          i marks the start of the variable
  '          j marks it end
  '**********************************************************
  If i=1 Then
    a$=VarStartMark$+Mid$(a$,i,j-i)+VarEndMark$+Mid$(a$,j)
  ElseIf j>Len(a$) Then
    a$=Left$(a$,i-1)+VarStartMark$+Mid$(a$,i)+VarEndMark$
  Else
    a$=Left$(a$,i-1)+VarStartMark$+Mid$(a$,i,j-i)+VarEndMark$+Mid$(a$,j)
  EndIf

End Sub 'MarkVariable

Sub BuildLabelArray
  '**********************************************************
  Print "Building list of Label, Function and Subroutine names."
  ' A single pass through the input file builds lists of
  ' label, subroutine and function names. This is only done if labels
  ' and/or Sub/Function names are NOT to be replaced.
  ' These names are treated as reserved words when later finding
  ' variables and will therefore not be replaced with a short name.
  ' Each label and Sub/Function name is written to a temporary file
  ' then read into an array, sorted and duplicates removed.
  '**********************************************************
  Local i,j,LabelsLoaded,LineNo
  ' Loop through the input file saving the label, sub and func names.
  Open LabelFile$ For output As #7
  Do
    Line Input #1,Cline$
    Cline$=StripBlanks$(Cline$)

    If NoLblChange Then
      Test_for_Label(Cline$,Label$)
      'Save the label name if one was found
      If Label$<>"" Then
        MaxLabels=MaxLabels+1
        Print #7, UCase$(Label$)
      EndIf
    EndIf

    If NoFuncNameChange Then
      ' Save the Subroutine or Function name if one is found
      Test_Sub_Function(Cline$,FnName$)
      If FnName$<>"" Then
        MaxLabels=MaxLabels+1
        Print #7, UCase$(FnName$)
      EndIf
    EndIf
  Loop Until Eof(#1)
  Close #1,#7

  'Open the input file again for the next processing stage
  Open Ifile$ For Input As #1

  'Load the labels into an array
  If MaxLabels>0 Then
    LoadArray(LabelFile$,MaxLabels)
    'Copy the generalised array into the labels array
    Dim Label$(MaxLabels)
    For i=1 To MaxLabels
      Label$(i)=UCase$(Entry$(i))
    Next
    Erase Entry$
  EndIf
End Sub 'BuildLabelArray

Sub LoadArray(Fname$,MaxEntries)
  '**********************************************************
  'This creates a sorted array, ignoring duplicates, taking input from a file.
  'This could be done by loading them all in and then sorting and finally
  'removing duplicates, bus since the numbers are likely to be relatively small
  'the slot-in method will probably be just as fast.
  '**********************************************************
  Local EntriesLoaded,i,j
  MaxEntries=MaxEntries+1   'The extra one is for a high-values entry
  Open Fname$ For Input As #7
  Dim Entry$(MaxEntries+1)
  Input #7,Entry$(1)
  Entry$(2)=Chr$(255)
  EntriesLoaded=2
  Do
    Input #7, a$
    For i=1 To EntriesLoaded
      If a$=Entry$(i) Then Exit For            'Ignor a duplicate
      If a$<Entry$(i) Then
        'Shuffle higher ones down the array and slot the new one in here
        For j=EntriesLoaded To i Step -1
          Entry$(j+1)=Entry$(j)
        Next j
        Entry$(i)=a$
        EntriesLoaded=EntriesLoaded+1
        Exit For
      EndIf
    Next i
  Loop Until Eof(#7)
  MaxEntries=EntriesLoaded-1         'This discards the high values entry
  Close #7
End Sub 'LoadArray

Sub GetNextNonBlankChar(a$, p, b$)
  '**********************************************************
  ' Returns b$ either empty indicating end of line or
  ' containing the next non-blank character.
  ' A comment (single quote or REM) also indicates end of line.
  ' Any text inside double quotes is skipped.
  ' On entry, p points to the next char to inspect in a$.
  ' On exit, b$ contains the next non-blank character and
  ' p points to the next character after the one in b$.
  '**********************************************************
  Do
    If p>=Len(a$) Then
      b$=""
    Else
      b$=Mid$(a$,p,1)
      If b$=Chr$(34) Then
        Do                         ' skip over quoted text
          p=p+1
        Loop Until Mid$(a$,p,1)=Chr$(34) Or p = Len(a$)
      EndIf
      p=p+1
    EndIf
  Loop Until b$="" Or b$<>" "
End Sub 'GetNextNonBlankChar

Function IsACommand(a$)
  '**********************************************************
  'Searches the Reserved word records for a$.
  'It looks at the first entry in the last record.
  'If a$ is greater or equal, it searches that record for a match.
  'If a$ is less, then ir repeats on the previous record.
  'This continues until it is found or not.
  'The function teturns True or False.
  '**********************************************************
  Local i,Found,EndOfRecord
  a$=UCase$(a$)
  Found=False
  EndofRecord=False
  For i=CMDrecs To 1 Step -1
    If a$ >= Left$(RWords$(i),instr(1,RWords$(i),",")-1) Then
      ps=1    'start pointer
      Do
        pe=Instr(ps,RWords$(i),",")
        If a$=Mid$(RWords$(i),ps,pe-ps) Then
          Found=True
        ElseIf pe=Len(RWords$(i)) Then
          EndOfRecord = True
        EndIf
        ps=pe+1
      Loop Until Found Or EndOfRecord
      Exit For
    EndIf
  Next
  IsACommand=Found
End Function 'IsACommand

Function IsALabel(v$)
  '**********************************************************
  'When Labels and/or Sub/Function names are not to be replaced
  'they need to be treated as commands.
  'This uses a binary search to find a$ (upper case) in Label$ array.
  'Returns a value of true or false.
  '**********************************************************
  Local found,indx,StartIndx,EndIndx,a$
  Found=false
  If MaxLabels>0 Then
      StartIndx=1
    EndIndx=MaxLabels
    'Labels and Sub/Function names never end in a ( whereas some commands do.
    If Right$(v$,1)="(" Then a$=Left$(v$,Len(v$)-1) Else a$=v$

    Do
      ' Find mid point of the section of the array to search
      Indx=StartIndx+Fix((EndIndx-StartIndx)/2)
      If a$=Label$(Indx) Then
        Found=true
      ElseIf a$>Label$(Indx) Then
        StartIndx=Indx+1
      Else
        EndIndx=Indx-1
      EndIf
    Loop Until Found Or StartIndx > EndIndx Or EndIndx < StartIndx
  EndIf
  IsALabel=Found
End Function 'IsALabel

Function RemoveCommentsAndBlankLines$(a$)
  '**********************************************************
  ' find the first quote or REM which is not surrounded by double quotes
  '**********************************************************
  Local i,b$
  Found=false
  b$=UCase$(a$)
  i=1
  If b$<>"" Then
    'If line not empty
    If Left$(b$,1)="'" Or Left$(b$,4)="REM " Or b$="REM" Then
      Found=True
    Else
      FindComment(b$,i)
      If i>0 Then Found=True
    EndIf
  EndIf
  If Found Then a$=Left$(a$,i-1)
  RemoveCommentsAndBlankLines$=a$
End Function 'RemoveCommentsAndBlankLines

Sub FindComment(b$,i)
  '**********************************************************
  ' Finds the first occurrence of single quote or REM in b$
  '**********************************************************
  Local a,b,c,d,c$
  c$=b$+" "                    'makes it easier to find REM at EOL
  Do
    a=Instr(i,c$,"'")
    b=Instr(i,c$," REM ")      'mid-line
    c=Instr(i,c$,":REM ")      'mid-line
    d=Instr(i,c$,Chr$(34))            'Double quote
    If a+b+c=0 Then                'No comment found
      i=0
    Else
      i=Len(c$)
      If a>0 And a<i Then i=a
      If b>0 And b<i Then i=b
      If c>0 And c<i Then i=c

      If d>0 And d<i Then i=Instr(d+1,c$,Chr$(34))+1
      'if a double quote found before the quote or REM then
      'repeat from the next double quote
    EndIf
  Loop Until i<d Or d=0 Or i=0
End Sub 'FindComment

Function StripBlanks$(A$)
  '**********************************************************
  ' Strips blanks from the beginning of the line.
  '**********************************************************
  Local i
  i=1
  Do While Mid$(A$,i,1)=" " Or Mid$(A$,i,1)=Chr$(9)
    i=i+1
  Loop
  StripBlanks$ = Mid$(A$,i)
End Function 'StripBlanks

Sub Test_LineEnd(Found, EOL)
  '**********************************************************
  ' Test if finished processing this line
  '**********************************************************
  If Len(CLine$)<=1 Or Left$(Cline$,1)="'" Or Left$(UCase$(Cline$),4)="REM " Then
    Found=True
    EOL=True
  EndIf
End Sub 'TestLineEnd

Sub Test_for_Label(Line$,Label$)
  '**********************************************************
  ' See if the line starts with a label. If so, return it.
  ' A label is terminated with a colon and musn't
  ' - have an imbedded blank or Separator.
  ' - be an MMBasic command terminated with a colon.
  '**********************************************************
  Local Found
  Found=False
  p=Instr(1,Cline$,":")                       ' Look for first colon
  If p<>0 Then       'Is Label if there is no imbedded blank or Separator
    Found=True
    For i=1 To p-1
      a$=Mid$(Cline$,i,1)
      If a$=" " Or IsSeparator(a$) Then
        Found=False
        Exit For
      EndIf
    Next
  EndIf
  ' Check that it is not a one word MMBasic command
  If found And p<>0 Then
    For i=1 To Commands
      If UCase$(Left$(Cline$,p-1))=Command$(i) Then
        Found=False
        Exit For
      EndIf
    Next
  EndIf
  If Found=True Then Label$=Left$(Line$,p-1) Else Label$=""
End Sub 'TestForLabel

Sub Test_Sub_Function(Line$,FnName$)
  '**********************************************************
  ' Sub and Function names are preceed by a blank and
  ' followed by either a blank or open bracket.
  '**********************************************************
  Local Found,strt,a,b,c
  Found=False
  If UCase$(Left$(Line$,4))="SUB " Then
    Strt=5
    Found=True
  ElseIf UCase$(Left$(Line$,9))="FUNCTION " Then
    Strt=10
    Found=True
  EndIf
  If Found Then
    GetNextNonBlankChar(Line$,Strt)
    ' Look for next blank, open bracket or comma. There may be one
    ' or more. Select the first one found.
    Strt=strt-1             ' as GetNextNonBlankChar has incremented Strt
    a=Instr(strt,Line$," ")
    b=Instr(Strt,Line$,"(")
    c=Instr(Strt,Line$,":")
    d=Len(Line$)+1
    ' Find the first occuring delimiter
    e=d
    If a<>0 And a<e Then e=a
    If b<>0 And b<e Then e=b
    If c<>0 And c<e Then e=c
    FnName$=Mid$(Line$,Strt,e-strt)
  Else
    FnName$=""
  EndIf
End Sub 'Test_Sub_Function

Function IsSeparator(a$)
  '**********************************************************
  ' Tests a$ to see if it is an Separator
  '**********************************************************
  Local i
  IsSeparator=False
  For i=1 To Separators
    If a$=Separator$(i) Then
      IsSeparator=True
      Exit For
    EndIf
  Next
End Function 'IsSeparator

  '*************************************************************************************
  '*** Initialisation functions beyond this point
  '*************************************************************************************

Sub GetParms(Ifile$, Ofile$, Indent)
  '**********************************************************
  ' Input and Output file names, indent and pause switch can come from
  ' 4 sources (in order of precedence:
  '  - MM.CMDLine$, the implied RUN command (supported from MMBasic v4.3A onward)
  '  - CMDParm$, a variable passed to Crunch from a chaining program
  '  - CRUNCH.DAT file in the same format as MM.CMDline$
  '  - User prompts
  ' If file names are missing from the first 2, the user is prompted to
  ' enter them. If indent and pause switch are omitted, defaults are used.
  '**********************************************************
  a$=MM.CmdLine$
  If a$<>"" Then
    Print "Getting parms from MM.CMDLine$."
    GetCMDLine(a$)
  ElseIf CMDParm$<>"" Then
    ' CMDParm$ is intended to be passed by a Chaining program
    Print "Getting parms from CMDParm$."
    GetCMDLine(CMDParm$)
  Else
    a$=GetParmsFromFile$(InDatFile$)
    If MM.Errno = 0 Then Print "Getting parms from file ";InDatFile$
    If a$<>"" Then GetCMDLine(a$)
  EndIf
  Do
    If Ifile$="" Then
      Input "Give me the Input  filename (.BAS assumed) - 'Exit' to exit: ", Ifile$
    EndIf
    If LCase$(Ifile$)="exit" Then End
    CheckInputFileName(Ifile$)
  Loop Until Ifile$<>""
  Do
    If Ofile$="" Then
      Input "Give me the Output filename (.bas assumed) - 'Exit' to exit: ", Ofile$$
    EndIf
    If LCase$(Ofile$)="exit" Then End
    CheckOutputFilename(Ofile$, Ifile$)
  Loop Until Ofile$<>""
End Sub 'GetParms

Function GetParmsFromFile$(InDatFile$)
  '**********************************************************
  'Gets the parameters from a file
  '**********************************************************
  Local a$
  Option error continue
  Open InDatFile$ For input As #3
  If MM.Errno = 0 Then
    Line Input #3,a$
    GetParmsFromFile$=a$
    Close #3
  EndIf
  Option error abort
End Function 'GetParmsFromFile

Sub GetCMDLine(a$)
  '**********************************************************
  ' Parses the command variable or data file for input and output file names
  ' and any switches and sets the appropriate variables.
  '**********************************************************
  Local i
  If a$<>"" Then
    ParmNo=10                 ' 2 file names and up to 8 switches
    ParmDelimiter$=" "        ' Set the delimiter between parms
    Dim Parm$(ParmNo)
    ParseParm (a$,ParmNo)
    Ifile$=Parm$(1)
    Ofile$=Parm$(2)
    NoRemoveComments=False
    NoFuncNameChange=False
    NoLblChange=     False
    PauseList=       False
    NoVarNameChange= False
    NoCombineLines=  False
    MaxLineLen=      DefaultLineLen
    Testing=         False
    i=2
    Do
      i=i+1
      If Parm$(i)="/C" Then
        NoRemoveComments=True
      ElseIf Parm$(i)="/F" Then
        NoFuncNameChange=True
      ElseIf Parm$(i)="/L" Then
        NoLblChange=True
      ElseIf Parm$(i)="/P" Then
        PauseList=True
      ElseIf Parm$(i)="/V" Then
        NoVarNameChange=True
      ElseIf Parm$(i)="/M" Then
        NoCombineLines=True
        MaxLineLen=Val(Right$(Parm$(i),Len(Parm$(i))-2))
        If MaxLineLen=0 Then MaxLineLen=DefaultLineLen
      Elseif Parm$(i)="/T" then
        Testing=True
      EndIf
    Loop Until Parm$(i)=""
  EndIf
  If testing Then
    Print " No Comments & Blanks=";NoRemoveComments
    print " No Function Change=  ";NoFuncNameChange
    print " No Label Change=     ";NoLblChange
    print " Pause List=          ";PauseList
    print " No Variable Change=  ";NoVarNameChange
    print " Compact lines=       ";CombineLines;" Max Line Length=";MaxlineLen
  EndIf
  Erase Parm$         'Finished with the Parm$ array
End Sub 'GetCMDLine$


Sub ParseParm(P$,j)
  '**********************************************************
  ' Parse the parameters on the Implied Run Command line
  '**********************************************************
  Local i
  Strt=1
  For i=1 To j
    Ptr=Instr(Strt,p$,ParmDelimiter$)
    If Ptr=0 Then Ptr=Len(a$)+1
    Parm$(i)=UCase$(Mid$(p$,Strt,Ptr-Strt))
    If Ptr>=Len(p$) Then Exit For
    Strt=Ptr
    FindNextParmDelimiter(a$,Strt)
  Next
End Sub 'ParseParm

Sub FindNextParmDelimiter(a$,p)
  '**********************************************************
  ' Fine the start of the next parameter
  '**********************************************************
  Do
    p=p+1
  Loop Until Mid$(a$,p,1)<>ParmDelimiter$ Or p=Len(a$)
End Sub 'FindNextParmDelimiter

Sub CheckInputFilename(Ifile$)
  '**********************************************************
  ' Adds .BAS if an extension is not provided and checks that is accessible
  '**********************************************************
  If Instr(1,Ifile$,".")=0 Then Ifile$=Ifile$+".bas"
  Option error continue
  Open Ifile$ For INPUT As #1
  If MM.Errno <> 0 Then
    Print Ifile$ " doesn't exist."
    Print
    Ifile$=""
  EndIf
  Option error abort
End Sub 'CheckInputFilename

Sub CheckOutputFileName(Ofile$, Ifile$)
  '**********************************************************
  ' Adds .BAS if an extension is not provided and checks that it does't alread exit.
  ' If it exists, asks user if ok to overwrite.
  '**********************************************************
  If Instr(1, Ofile$, ".") = 0 Then Ofile$ = Ofile$ + ".bas"
  If LCase$(Ofile$)=LCase$(Ifile$) Then
    Print "You cannot write to the input file - give me another."
    Print
    Ofile$=""
  ElseIf LCase$(Ofile$) <> "exit" Then
    ' If old file exists, ask if it should be replaced. If not, get another filename
    Option error continue
    Open Ofile$ For input As #2
    If MM.Errno = 0 Then
      Print "OK to overwrite "+Ofile$+" Y/N";:Input ""; Reply$
      If LCase$(Left$(Reply$,1)) = "y" Then
        Close #2
        Print
        Open Ofile$ For output As #2
      Else
        Close #2
        Print
        Ofile$=""
      EndIf
    EndIf
    Option error abort
  EndIf
End Sub 'CheckOutputFilename

Sub PrintInstructions
  '**********************************************************
  Print Space$(20) "Program Source Cruncher v1.0"
  Print Space$(20) "============================"
  Print "This program reads a basic program file and modifies it depending upon"
  Print "switches provided on the invoking command line. The result is written"
  Print "to a new file. Input and output filenames mus be different."
  Print
  Print " CRUNCH InFileName OutFileName [switch [switch... switch]]"
  Print
  Print "Switches:"
  Print "  Omitting all switches selects all switch options except Testing."
  Print "  /c causes all Comments and blank lines to be left unchanged"
  Print "  /f causes function an sub names to be left unchanged."
  Print "  /l causes label names to be left unchanged"
  Print "  /p pauses the screen list at the end of each screenful"
  Print "  /v causes variable names to be left unchanged"
  Print "  /m causes creation of multi-statement lines to be suppressed."
  Print "  /t prints debug messages and suppresses removal of temp files."
  Print
End Sub 'PrintInstructions

Sub WriteCrunchPart2ParmFile
  '**********************************************************
  'Write file of parameters for Crunch Part II
  '**********************************************************
  print "Writing parameter file ";OutDatFile$;" for Crunch Part II"
  Open OutDatFile$ For Output As #8
  Print #8, VariableFile$;",";TempFile$;",";Ofile$
  Print #8, MaxVariables;",";VarStartMark$;",";VarEndMark$
  Print #8, PauseList;",";NoCombineLines;",";MaxLineLen
  print #8, Testing
  Close #8
End Sub 'WriteCrunchPart2ParmFile

Sub LoadReservedWords(RwordFile$)
  '**********************************************************
  ' Load a CSV file of MMBasic reserved words.
  ' Count the number of records then dimension the array
  ' and load each record into the array. Each record
  ' contains part of the list of sorted reserved words.
  '**********************************************************
  Local i
  Print "Loading Reserved Word file ";RWordFile$
  Open RWordFile$ For input As #4
  CMDRecs=0
  Do
    Line Input #4, a$
    CMDRecs=CMDRecs+1
  Loop Until Eof(#4)
  Close #4
  Dim RWords$(CMDRecs)
  Open RWordfile$ For input As #4
  i=1
  Do While Not Eof(#4)
    Line Input #4, RWords$(i)
    i=i+1
  Loop
  Close #4
End Sub 'LoadReservedWords

Sub PrintMsg(Msg$)
  '**********************************************************
  ' Causes the program to pause at the end of each screenful.
  ' Any keystroke causes the program to continue.
  '**********************************************************
  If PauseList Then
    Print Msg$
    w=w+1
    If w>30 Then
      w=0
      Do
        k$=Inkey$
      Loop Until k$<>""
    EndIf
  EndIf
End Sub 'Wait
